perm filename NEWPRE.SAI[3,ALS] blob
sn#050668 filedate 1973-06-25 generic text, type T, neo UTF8
00010 ENTRY PREPARE;
00020 BEGIN "XPREPARE"
00030
00040 DEFINE ⊂="COMMENT"; ⊂ This package contains all of the procedures
00050 that are used to process the input to obtain data in a form suitable
00060 for use in the signature tables which, in turn are processed by a
00070 separate MAC package SIG.;
00080
00090
00100 EXTERNAL REAL ARRAY A,B,C[0:256];
00110 EXTERNAL INTEGER ARRAY INRAW,INDAT,INSUB,INDIV,INCNT,INNAM[0:24];
00120 DEFINE LISSIZ="760";
00130 EXTERNAL INTEGER ARRAY LIST[0:LISSIZ];
00140 EXTERNAL INTEGER ARRAY SUMDAT[0:1536];
00150 EXTERNAL INTEGER M,N,P;
00160 EXTERNAL INTEGER MINK,MINLOC,MAXK,MAXLOC,SEGC,SEGMRK,STEPS,INFLAG;
00170 INTEGER ARRAY DELDAT[0:24];
00180
00190 PROCEDURE INSET;
00200 BEGIN
00210 IF INRAW[P]<INSUB[P] THEN INSUB[P]←INRAW[P];
00220 IF INDIV[P]<INRAW[P] THEN INDIV[P]←INRAW[P];
00230 ⊂ INCNT[P]←INCNT[P]+1;
00240 END "INSET";
00250
00260
00270 REAL SX;INTEGER NC; ⊂ **** SX GIVES FREQ INCREMENT PER FFT POINT ;
00280 ⊂ **** NC IS THE NO OF FFT POINTS;
00290 DEFINE SPEC="C" ; ⊂ **** ARRAY FOR FFT;
00300
00310
00320 ⊂ **** GLOBALS FOR PARAEX ;
00330 INTEGER NP,NZ,FP1,FP2,FZ ;
00340 REAL NPA,NZA,FP1A,FP2A,FZA, LPE,HPE,AVE ,LA,HA,HL;
00350 INTEGER ARRAY FF[1:5] ; REAL ARRAY AMP[1:5] ;
00360 REAL PROCEDURE BAL(INTEGER M);
00370 BEGIN REAL XX;
00380 XX←M-((SPEC[M-1]-SPEC[M+1])/(SPEC[M-1]+SPEC[M]+SPEC[M+1]));
00390 RETURN(XX);
00400 END "BAL";
00410
00420 INTEGER PROCEDURE ABS(INTEGER M); BEGIN IF M<0 THEN M←-M; RETURN(M) END ;
00430
00440
00450
00460
00470 ⊂ **** GLOBAL PARAMETER RANGES. SET IN "MAIN" PROGRAMME;
00480 EXTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG, FP1L,FP1H,FP2L,FP2H,
00490 ILPB,ILPC, IHPB,IHPC ;
00500 ⊂ THE PARA LIMITS ARE (DOUBLE CHECK) F1=200/800 F2=700/2050 F3=2000/3200
00510 NP=800/1500 NZRNG=NP+/-500 ?
00520 FP1=1800/3200 FP2=3200/5000 LPE=300/450 HPE=2500/3000 ;
00530 ⊂ **** I2H CHANGED FROM 28 TO 26 ESCAPE HI AMP F3 ;
00540 ⊂ SX←SF/(2.*NC),I1L←200./SX,I1H←800./SX+.5,I2L←700./SX,I2H←2050./SX+.5;
00550 ⊂ I3L←1950./SX, I3H←3250./SX+.5;
00560 ⊂ INL←800./SX, INH←1500./SX+.5, NZRNG←500./SX+.5;
00570 ⊂ FP1L←1800./SX, FP1H←3200./SX, FP2L←3200./SX+.5, FP2H←5000./SX+.5;
00580 ⊂ ILPB←300./SX, ILPC←450./SX, IHPC←2500./SX, IHPB←3000./SX;
00590
00600 PROCEDURE F2DECI;
00610 ⊂ **** DECIDE IF F2 CLOSE TO F1;
00620 ⊂ ********* FIX TH & 12.(DBS) ONLY AFTER EXING I'S U'S AND A'S;
00630
00640 BEGIN
00650 REAL SUML,SUMH,TH; INTEGER I;
00660
00670 TH←6.0 ; SUML←0.;
00680 FOR I←I2L STEP 1 UNTIL I1H DO SUML←SUML+SPEC[I];
00690 SUML←SUML/(I1H-I2L+1.0);
00700
00710 SUMH←0.; FOR I←I3L STEP 1 UNTIL I2H DO SUMH←SUMH+SPEC[I];
00720 SUMH←SUMH/(I2H-I3L+1.0);
00730
00740 IF SUML>SUMH+TH+12.0 THEN FF[2]←FF[1]+1 ;
00750 ⊂ OUTSTR(NL&"SUML="&CVF(SUML)&"SUMH="&CVF(SUMH));
00760 END "F2DECI";
00770
00780
00790
00800 INTEGER PROCEDURE PEAK(INTEGER I1,I2);
00810 ⊂ **** THIS PROCEDURE LOOKS AT A SECTION BETWEEN I1 & I2 AND LOCATES
00820 A PROPER PEAK;
00830 BEGIN
00840 LABEL L1,L2; REAL YMX; INTEGER I,IX;
00850 YMX←-1000.0;
00860 L1: FOR I←I1 STEP 1 UNTIL I2 DO
00870 IF YMX<SPEC[I] THEN BEGIN YMX←SPEC[I]; IX←I END;
00880 IF IX=I1 THEN BEGIN
00890 WHILE YMX>SPEC[I1+1] DO
00900 BEGIN I1←I1+1; IF I1=I2 THEN GOTO L2; YMX←SPEC[I1] END;
00910 GOTO L1 END;
00920 IF IX=I2 THEN BEGIN
00930 WHILE YMX>SPEC[I2-1] DO
00940 BEGIN I2←I2-1; IF I2=I1 THEN GOTO L2;
00950 YMX←SPEC[I2] END;
00960 GO TO L1; END;
00970 RETURN(IX);
00980 ⊂ OUTSTR(NL&NL&"NO PROPER PEAKS IN SAMPLE NO="&CVS(N)); L2 : RETURN(IX);
00990 END "PEAK";
01000 INTEGER I,J;
01010 PROCEDURE FORMANTS;
01020 ⊂ **** I1L,I1H,I2L,I2H,I3L,I3H DEFINE THE RANGES RES FORMANTS;
01030 ⊂ **** SPEC[FFT,TIME]=SPECTRUM(GLOBAL);
01040 ⊂ **** INTEGER FF[5]& REAL AMP[5] (GLOBAL);
01050 ⊂ **** LOWER F2H LIMIT TO AVOID HIGH ENERGY F3, CATCH PROPER F2 BY AMP COMPARISON;
01060
01070 BEGIN
01080 IF INFLAG=1 THEN BEGIN
01090 INNAM[P]←LIST[P]←CVSIX("F1"); INNAM[P+1]←LIST[P+1]←CVSIX("F2"); P←P+2;
01100 INNAM[P]←LIST[P]←CVSIX("F3"); INNAM[P+1]←LIST[P+1]←CVSIX("A1"); P←P+2;
01110 INNAM[P]←LIST[P]←CVSIX("A2"); INNAM[P+1]←LIST[P+1]←CVSIX("A3"); P←P+2; END ELSE BEGIN
01120 INTEGER I;⊂ EXTERNAL INTEGER PROCEDURE PEAK(INTEGER I1,I2);
01130 ⊂ EXTERNAL PROCEDURE F2DECI;
01140 FF[1]←PEAK(I1L,I1H);
01150 FF[2]←PEAK(I2L,I2H);
01160 FF[3]←PEAK(I3L,I3H);
01170 IF FF[1]=FF[2] THEN BEGIN FF[2]←PEAK(I1H,I2H); F2DECI END ;
01180 ⊂ **** F2DECI ON SPECTRAL BALANCE ;
01190 IF SPEC[FF[2]]+6.0<SPEC[FF[3]] THEN BEGIN FF[2]←FF[3] ;
01200 FF[3]←PEAK(FF[3],I3H) END ;
01210
01220 IF FF[2]=FF[3] THEN FF[3]←PEAK(FF[3],I3H) ;
01230 ⊂ FF[4]←PEAK(I1H,I3L);
01240 ⊂ FF[5]←PEAK(I3H,I3H+10);
01250 FOR I←1 STEP 1 UNTIL 3 DO
01260 AMP[I]←SPEC[FF[I]];
01270 INDAT[P]←(BAL(FF[1])-2)*63./7.;⊂ INRAW[P]←FF[1];⊂ INSET; P←P+1;
01280 INDAT[P]←(BAL(FF[2])-I2L)*(63./20);⊂ INRAW[P]←FF[2];⊂ INSET; P←P+1;
01290 INDAT[P]←(BAL(FF[3])-25)*(63./16.);⊂ 26 16 INRAW[P]←FF[3];⊂ INSET; P←P+1;
01300 INDAT[P]←(AMP[1]-10.)*(63./18.6); ⊂ INRAW[P]←AMP[1] ;⊂ INSET; P←P+1;
01310 INDAT[P]←(AMP[2]-10)*(63./16.5);⊂ 30 16 INRAW[P]←AMP[2];⊂ INSET; P←P+1;
01320 INDAT[P]←(AMP[3]-10.)*(63./16.5);⊂ 25 16 INRAW[P]←AMP[3];⊂ INSET; P←P+1;
01330
01340
01350 END;
01360 END "FORMANTS";
01370
01380
01390
01400 PROCEDURE FRINAS ; BEGIN
01410 IF INFLAG=1 THEN BEGIN
01420 INNAM[P]←LIST[P]←CVSIX("FP1"); INNAM[P+1]←LIST[P+1]←CVSIX("FP1A"); P←P+2;
01430 INNAM[P]←LIST[P]←CVSIX("FP2"); INNAM[P+1]←LIST[P+1]←CVSIX("FP2A"); P←P+2;
01440 INNAM[P]←LIST[P]←CVSIX("FZ"); INNAM[P+1]←LIST[P+1]←CVSIX("FZA"); P←P+2;
01450 INNAM[P]←LIST[P]←CVSIX("NP"); INNAM[P+1]←LIST[P+1]←CVSIX("NPA"); P←P+2;
01460 INNAM[P]←LIST[P]←CVSIX("NZ"); INNAM[P+1]←LIST[P+1]←CVSIX("NZA"); P←P+2; END ELSE BEGIN
01470 ⊂ EXTERNAL INTEGER PROCEDURE PEAK(INTEGER I1,I2);
01480 NP←PEAK(INL,INH); FP1←PEAK(FP1L,FP1H); FP2←PEAK(FP2L,FP2H);
01490 FP1A←SPEC[FP1]; FP2A←SPEC[FP2]; NPA←SPEC[NP];
01500 BEGIN "ZEROS" REAL XNZ; INTEGER STP,JX,J;
01510 STP←(NZRNG)/ABS(NZRNG); XNZ←10000.;
01520 FOR J←NP STEP STP UNTIL NP+NZRNG DO
01530 IF XNZ>SPEC[J] THEN BEGIN XNZ←SPEC[J]; JX←J END;
01540 NZ←JX; NZA←SPEC[NZ]; XNZ←10000.;
01550 FOR J←FP1 STEP 1 UNTIL FP2 DO
01560 IF XNZ>SPEC[J] THEN BEGIN XNZ←SPEC[J]; JX←J END;
01570 FZ←JX; FZA←SPEC[FZ];
01580 END "ZEROS";
01590 INDAT[P]←(BAL(FP1)-24)*(63./14.2);⊂ INRAW[P]←FP1;⊂ INSET; P←P+1;
01600 INDAT[P]←(FP1A-10)*(63./16.5);⊂ 24 16 INRAW[P]←FP1A;⊂ INSET; P←P+1;
01610 INDAT[P]←(BAL(FP2)-39.)*(63./18.5);⊂ 42 18 INRAW[P]←FP2;⊂ INSET; P←P+1;
01620 INDAT[P]←(FP2A-25.)*(63./19.);⊂ INRAW[P]←FP2A;⊂ INSET; P←P+1;
01630 INDAT[P]←(FZ-31.5)*(63./16.2);⊂ 32 16.2 INRAW[P]←FZ;⊂ INSET; P←P+1;
01640 INDAT[P]←(FZA-10.)*(63./19.) ;⊂ 12 21 INRAW[P]←FZA;⊂ INSET; P←P+1;
01650 INDAT[P]←(BAL(NP)-INL)*(63./9.);⊂ INRAW[P]←NP;⊂ INSET; P←P+1;
01660 INDAT[P]←(NPA-10)*(63./19.5);⊂ 28 20 INRAW[P]←NPA;⊂ INSET; P←P+1;
01670 INDAT[P]←(NZ-14)*(63./9.2);⊂ INRAW[P]←NZ;⊂ INSET; P←P+1;
01680 INDAT[P]←(NZA-10.)*(63./18.);⊂ 18 21 INRAW[P]←NZA;⊂ INSET; P←P+1;
01690
01700
01710 END;
01720 END "FRINAS";
01730 PROCEDURE SEGPAR;
01740 BEGIN "SEGPAR"
01750 IF INFLAG=1 THEN BEGIN
01760 INNAM[P]←LIST[P]←CVSIX("LPE"); INNAM[P+1]←LIST[P+1]←CVSIX("AVE"); P←P+2;
01770 INNAM[P]←LIST[P]←CVSIX("HPE"); P←P+1;
01780 INNAM[P]←LIST[P]←CVSIX("LA");
01790 P←P+1; INNAM[P]←LIST[P]←CVSIX("HA"); P←P+1;
01800 INNAM[P]←LIST[P]←CVSIX("HL"); P←P+1; END ELSE BEGIN
01810 INTEGER J,K;
01820 ⊂ ***** COMPUTE LOW-PASS POWER ;
01830 LPE←0.0;
01840 FOR J←1 STEP 1 UNTIL ILPB DO
01850 LPE←LPE+SPEC[J];
01860
01870 K←ILPC-ILPB;
01880 FOR J←ILPB+1 STEP 1 UNTIL ILPC DO LPE←LPE+(SPEC[J]*(ILPC-J)/K);
01890 LPE←LPE/ILPC;
01900
01910 ⊂ ***** COMPUTE HIGH-PASS POWER;
01920
01930 HPE←0.0; K←IHPB-IHPC;
01940 FOR J←IHPC STEP 1 UNTIL IHPB-1 DO HPE←HPE+(SPEC[J]*(J-IHPC)/K);
01950 FOR J←IHPB STEP 1 UNTIL NC DO HPE←HPE+SPEC[J];
01960 HPE←HPE/(NC-IHPC);
01970
01980 ⊂ ***** COMPUTE AVERAGE POWER;
01990 AVE←0.0;
02000 FOR J←0 STEP 1 UNTIL NC DO AVE←AVE+SPEC[J];
02010 AVE←AVE/NC;
02020
02030 LA←LPE/AVE; HA←HPE/AVE; HL←HPE/LPE;
02040
02050 INDAT[P]←(LPE-10.)*(63./10.5);⊂ 23 12 INRAW[P]←LPE;⊂ INSET; P←P+1;
02060 INDAT[P]←(AVE-1.2)*(63./6.7);⊂ 9 7.5 INRAW[P]←AVE;⊂ INSET; P←P+1;
02070 INDAT[P]←(HPE-6)*(63./6.5);⊂ INRAW[P]←HPE;⊂ INSET; P←P+1;
02080 INDAT[P]←(LA-1.)*(63./1.20); P←P+1;
02090 INDAT[P]←(HA-.60)*(63./.13); P←P+1;
02100 INDAT[P]←(HL-.14)*(63./.3); P←P+1;
02120 END;
02130 END "SEGPAR";
02140
00010
00020 INTERNAL PROCEDURE PREPARE;
00030 BEGIN
00040
00050 P←0; ⊂ Each procedure puts results in sequential locations in INRAW[P]
00060 and calls INSET which computes corresponding values INDAT[P] and updates P;
00070 P←0; NC←N;
00080 FORMANTS;
00090 FRINAS;
00100 SEGPAR;
00110 END;
00120 END "XPREPARE";
00130